home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / VIEW.SEQ < prev    next >
Text File  |  1988-06-01  |  10KB  |  226 lines
  1. \ VIEW.SEQ      Viewing code for ZF.                    by Tom Zimmer
  2.  
  3. variable viewlen
  4.  
  5. : >VIEWLINE     ( n1 --- )      \ move to line n1 of currently open file.
  6.                 dup >r 0 shndl @ movepointer
  7.                 IBRESET
  8.                 errorline off
  9.                 r> loadline ! ;
  10.  
  11. : <viewlines>   ( n1 n2 --- )
  12.                 loadline @ >r viewlen off
  13.                 swap    0
  14.                 do      lineread dup c@ 0= if drop leave then
  15.                         cr count 2- 0 max
  16.                         i 3 pick =
  17.                         if      >attrib2 type >norm  \ underline it.
  18.                         else        type 77 #out @ - spaces
  19.                         then    outbuf c@ viewlen +!
  20.                 loop    drop cr r> loadline ! ;
  21.  
  22. : VIEWLINES     ( n1 n2 --- )   \ n1 lines to view, n2 line to underline.
  23.                 >rev shndl @ count type >norm <viewlines> ;
  24.  
  25. : NAME>PAD      ( A1 --- PAD )
  26.                 >r r@ ys: ?cs: pad r> yc@ 31 and 1+ cmovel  \ move name
  27.                 pad c@ 31 and pad c!                        \ clip count
  28.                 pad count + 1- dup c@ 127 and swap c!       \ mask last ch
  29.                 PAD     ;
  30.  
  31. : ?prepend.vpath ( a1 --- a1 )
  32.                 >r r@ 3 + c@ ascii \ =                  \ ? already have path
  33.                 if r> exit then                         \ then leave
  34.                 r@ count viewpath count + swap cmove
  35.                 r@ c@ viewpath c@ +                     \ total length
  36.                 dup r@ c!                               \ to a1
  37.                 viewpath 1+ r@ 1+ rot cmove             \ move data to a1
  38.                 viewpath count + off                    \ erase extra viewpath
  39.                 r> ;                                    \ return a1
  40.  
  41. comment:
  42. : >viewfile     ( cfa --- offset a1 )   \ returns the string name in PAD
  43.                 filelist                \ of the file containing cfa as a1
  44.                 begin   @ 2dup u> until \ step to proper file name.
  45.                 SWAP    >view y@        \ Also returns offset to source def.
  46.                 SWAP    BODY> >NAME name>pad ?prepend.vpath ;
  47. comment;
  48.  
  49. : files_set     ( --- )
  50.                 ['] files >body HERE 500 + #THREADS 2* CMOVE ;
  51.  
  52. : 1file         ( --- false | nfa )
  53.                 HERE 500 + #THREADS LARGEST DUP
  54.                 if      DUP L>NAME >r Y@ SWAP ! r>
  55.                 else    nip
  56.                 then    ;
  57.  
  58. 0 constant maxname
  59. 0 constant maxcfa
  60.  
  61. : >viewfile     ( cfa --- offset a1 )
  62.                 >r files_set 0 =: maxcfa 0 =: maxname
  63.                 begin   1file dup
  64.                 while   r@ over name> u>
  65.                         if      dup name> maxcfa u>
  66.                                 if      dup =: maxname
  67.                                         dup name> =: maxcfa
  68.                                 then
  69.                         then    drop
  70.                 repeat  drop r> >view y@
  71.                 maxname name>pad ?prepend.vpath ;
  72.  
  73. : <VIEW>        ( a1 --- f1 )   \ VIEW the name specified by a1 the cfa
  74.                 >viewfile       ( --- offset f1 )
  75.                 $hopen dup 0=
  76.                 if      swap dark cr
  77.                         >viewline 17 0 viewlines  \ show 17 lines from file.
  78.                 else    nip
  79.                 then    ;
  80.  
  81. variable foundit
  82.  
  83. : <HELP>        ( a1 --- f1 )   \ Show the HELP for a word specified by a1
  84.                 >viewfile >r drop
  85.                 " HLP" ">$ r@ $>ext
  86.                 r> $hopen dup 0=
  87.                 if      IBRESET
  88.                         0.0 seek loadline off
  89.                         ."  Looking..." foundit off
  90.                         8000 1
  91.                         do      lineread c@ 0= ?leave
  92.                                 bl outbuf count + 2- c!
  93.                                      \ have at least 1 blank at end of line.
  94.                                 here count outbuf 1+ swap 1+ caps-comp 0=
  95.                                 if      dark cr ." Line " i u. ." of "
  96.                                         loadline @ >viewline 17 0 viewlines
  97.                                         foundit on leave
  98.                                 then    outbuf c@ loadline +!
  99.                         loop    foundit @ 0=
  100.                         if      ." ..Sorry, no information available"
  101.                         then    cr
  102.                 then    ;
  103.  
  104. : .VIEWHELP     ( --- )
  105. dark
  106. cr cr 24 spaces >rev ."  HELP ME GET STARTED! " >norm
  107. cr cr
  108. ." To obtain help on a particular word,        type: HELP <wordname> <enter>" cr
  109. ." To see the source code for a word,          type: VIEW <wordname> <enter>" cr
  110. ." To find out what commands are available,    type: WORDS <enter>" cr
  111. ."    (space pauses, ESC stops list)" cr
  112. ." To find out which words contain a" cr
  113. ."    particular letter sequence,              type: WORDS <letters> <enter>" cr
  114. ." To see a decompiled source for a word,      type: SEE  <wordname> <enter>" cr
  115. ." To open a file, use VIEW above, or          type: OPEN <filename> <enter>" cr
  116. ." To edit the currently open file,            type: ED <enter>" cr
  117. ."    (press ESC to leave the editor)" cr
  118. ." To create a file, or select a file to edit, type: SED <enter>" cr
  119. cr
  120. ." Type the following command sequence for a couple of examples: cr
  121. cr
  122. 10 spaces ." OPEN INTRO <enter>" cr
  123. 10 spaces ." L <enter>" cr
  124. cr
  125. ." See the accompanying .TXT files for further descriptions of FF." cr ;
  126.  
  127. : VIEW          ( | name --- )  \ VIEW is followed on the same line by name.
  128.                 >in @ span @ 1- >       \ if nothing following command
  129.                 if      .viewhelp       \ display the help screen
  130.                 else    ' <view>
  131.                         if      cr ." File " .SHNDL ."  is not available."
  132.                         then
  133.                 then    ;
  134.  
  135. ' view alias LL         ( | name --- )  \ LL is a pseudonym for VIEW
  136.  
  137. : HELP          ( | name --- )  \ VIEW is followed on the same line by name.
  138.                 >in @ span @ 1- >       \ if nothing following command
  139.                 if      .viewhelp       \ display the help screen
  140.                 else    ' <help>
  141.                         if      cr ." File " .SHNDL ."  is not available."
  142.                         then
  143.                 then    ;
  144.  
  145. : ?fileopen     ( --- )                 \ Verify a file is open.
  146.                 shndl @ >hndle @ 0<
  147.                 abort" A file MUST be open to perform this operation." ;
  148.  
  149. : L             ( --- )         \ display 18 lines starting at current
  150.                 ?fileopen
  151.                 dark cr           \ loadline marker.
  152.                 loadline @ >viewline
  153.                 18 -1 viewlines ;
  154.  
  155. : LIST          ( n1 --- )      \ n1 is the line number to list from
  156.                 ?fileopen
  157.                 >line L ;
  158.  
  159. : LOAD          ( n1 --- )      \ n1 is the line number to load from
  160.                 ?fileopen
  161.                 >line           \ move to line n1
  162.                 cr ." Loading.." <load>  ;
  163.  
  164. : +lines        ( n1 --- )      \ move forward n1 lines in the current file.
  165.                 loadline @ >viewline
  166.                 0 swap 0
  167.                ?do      lineread c@ + outbuf c@ 0= ?leave
  168.                 loop    loadline +! ;
  169.  
  170. : N             ( --- )         \ go forward 16 lines and display 18 lines.
  171.                 ?fileopen
  172.                 16 +lines L ;
  173.  
  174. : -1line        ( --- )      \ backup 1 line from current loadline
  175.                 loadline @ dup 0> swap 256 - swap
  176.                 if      0 max
  177.                 then    0 shndl @ movepointer
  178.                 IBRESET
  179.                 instart 256 loadline @ dup 0>
  180.                 if      min  else drop then
  181.                 shndl @ INBSEG EXHREAD =: inlength
  182.                 inlength instart over 2- 0 max bounds swap
  183.                ?do      INBSEG  i c@L 10 =       \ is char an LF
  184.                         if      drop instart inlength + i 1+ -
  185.                                 leave
  186.                         then
  187.             -1 +loop    negate loadline +! ;
  188.  
  189. : -lines        ( n1 --- )      \ backup n1 lines in the current file.
  190.                 0
  191.                ?do      -1line
  192.                loop     ;
  193.  
  194. : B             ( --- )         \ backup 16 lines in current file and
  195.                 ?fileopen
  196.                 16 -lines L ;   \ display 18 lines.
  197.  
  198. \ installation routine, added to the list of stuff to do when installing
  199. \ FF for a new system.
  200.  
  201. : setview       ( | name --- )  \ set the path for all views
  202.                 >in @ span @ 1- >       \ if nothing following command
  203.                 if      viewpath clr-hcb
  204.                         viewpath prepend.path drop
  205.                 cr ." ******"
  206. cr ." The current PATH where F-PC searches for system sources when viewing is"
  207. cr cr tab >rev viewpath count type >norm cr
  208. cr ." Type in the New VIEW PATH (where the system sources are located),"
  209. cr ." or press <enter> alone to leave the VIEW PATH the same. "
  210. cr ." VIEW PATH ->"
  211.                         query
  212.                 then
  213.                 >in @ span @ 1- > 0=
  214.                 if      viewpath clr-hcb
  215.                         bl word viewpath over c@ 1+ cmove
  216.                 then    cr cr tab
  217.                 ." VIEW PATH set to " >rev viewpath count type >norm ;
  218.  
  219. : installviewpath  ( --- )
  220.                 defers installstuff
  221.                 span @ >in !
  222.                 setview ;
  223.  
  224. ' installviewpath is installstuff
  225.  
  226.